perm filename EDGE.SAI[SYS,HE]9 blob
sn#027753 filedate 1973-03-06 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00024 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00007 00002 ENTRY EDGE_KKP
00013 00003 DEFINITIONS AND STORAGE ALLOCATION
00016 00004 DEBUGGING ROUTINES
00019 00005 TIMING ROUTINES AND MISC. ROUTINES
00021 00006 ⊃ TRUE IF POINT BLOCKS A AND B ARE FROM
00023 00007 ⊃ REGENERATE AS MUCH DISPLAY AS NECESSARY
00026 00008 HOUSEKEEPING TASKS COMMON TO PNTMOV AND PNTCOP
00029 00009 COPY A SEGMENT TO NEW OBJECT
00032 00010 EDGE FOLLOWER ENTRY STARTS HERE
00038 00011 TRACE AROUND AN OBJECT. TRUE IF AN EDGE TRACED
00041 00012 ⊃ beginning of trace loop
00044 00013 ⊃ if edge if found, test if seen before at this location.
00046 00014 ⊃ cannot find edge again
00048 00015 ⊃ terminate segment and reverse to try to scan from other
00051 00016 ⊃ if segment is too small, delete it.
00053 00017 ⊃ update internal data structures for the new point
00056 00018 ⊃ end of this segment, update data structure and return
00059 00019 ⊃ update object status and terminate trace procedure
00060 00020 ⊃ HORIZONTAL SCAN FOR OBJECT TO TRACE - TRUE IF NONE FOUND
00063 00021 FINE SCAN AREA USING MANFRED OPERATOR FOR EDGE
00065 00022 OUTPUT STATUS INFO TO CALLING JOB FOR EACH OBJECT
00067 00023 SEARCH DATA STRUCTURE FOR DANGLING SEGMENT ENDS
00069 00024 ⊃ TEST PARAMETERS. BODY OF EDGE STARTS HERE
00072 ENDMK
⊗;
ENTRY EDGE_KKP;
BEGIN "OUTSID" COMMENT OUTSIDE EDGE SCANNER (WITH MODS FOR INSIDE);
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
REQUIRE 500 STRING_SPACE;
DEFINE REF="REFERENCE", INTE="INTEGER", BOOL="BOOLEAN", EXT="EXTERNAL";
EXT PROCEDURE CWHEEL(INTE C);
EXT PROCEDURE INTPNT;
EXT INTE PROCEDURE GENTER(INTE X,Y;REF BOOL TEST;REF INTE DIR);
EXT PROCEDURE EJINIT(INTEGER SIZE);
EXT INTE PROCEDURE SEEN(REAL X, Y, INC; REF INTE PNTR);
EXT PROCEDURE GLINKR(INTE PNTRA, FLDA, PNTR, FLD; REF BOOL E);
EXT PROCEDURE GCRERI(INTE PNTRA, FLDA, PNTR, FLD; REF BOOL E);
EXT PROCEDURE SEINT(INTE SIDLEN, COUNT;REF INTE A, B, C);
EXT PROCEDURE GSTORD(INTE VAL, PNTR, CNT; REF BOOL ERROR);
EXT INTE PROCEDURE GGETD(INTE PNTR, CNT; REF BOOL ERROR);
EXT PROCEDURE PTINIT(INTE X, Y);
EXT INTE PROCEDURE GCREBL(INTE NAME; REF BOOL ERROR);
EXT BOOL PROCEDURE GIFTIE(INTE PNTR, FLD; REF BOOL ERROR);
EXT PROCEDURE GSETST(INTE MASK, PNTR; REF BOOL ERROR);
EXT PROCEDURE GRSETS(INTE MASK, PNTR; REF BOOL ERROR);
EXT PROCEDURE GFORWR(REF INTE PNTR, FLD; REF BOOL ERROR);
EXT PROCEDURE GBACK(REF INTE PNTR, FLD; REF BOOL ERROR);
EXT PROCEDURE GDOWN(REF INTE PNTR, FLD; REF BOOL FLAG);
EXT INTE PROCEDURE GKILBL(REF INTE PNTR; REF BOOL FLAG);
EXT BOOL PROCEDURE GSTATZ(INTE MASK, PNTR; REF BOOL ERR);
EXT BOOL PROCEDURE GSTATO(INTE MASK, PNTR; REF BOOL ERR);
EXT PROCEDURE GUP(REF INTE PNTR, FLG; REF BOOL ERR);
EXT INTE PROCEDURE GCOUNT(INTE PNTR, FLD; REF BOOL ERR);
EXT PROCEDURE GULNKR(INTE PNTR, FLD; REF BOOL FLAG);
EXT PROCEDURE GULINK(INTE PNTR, FLD; REF BOOL FLAG);
EXT PROCEDURE RENUM(INTE OLDNUM, NEWNUM);
EXT INTE PROCEDURE GETOBJ(REF ITEMVAR ARG;BOOL FLG;REF BOOL PROCEDURE XEQ);
EXT INTE PROCEDURE YOPER(INTE X, Y;REF INTE ANGLE;INTE CW;BOOL TRAC,FLAG);
EXT REAL PROCEDURE FOOLX(INTE A);
EXT PROCEDURE REJSUB(REF ITEMVAR ARG; REF INTE STATUS);
EXT BOOL PROCEDURE GIFTYP(INTE TYPE, PNTR; REF BOOL FLG);
EXT PROCEDURE FADCHG(REAL X,Y; PROCEDURE FOO);
EXT PROCEDURE FRDCHG(REAL X,Y; PROCEDURE FOO);
EXT PROCEDURE DPYPNT(INTE X,Y);
EXT BOOL PROCEDURE PLTPNT(INTE OBJLST; REF INTE BUF);
EXT BOOL PROCEDURE GETEND(INTE SEG; REF INTE LEFT, RIGHT);
EXT PROCEDURE PTPNT(INTE TEMPSAI);
EXT PROCEDURE ADJSTK(REF INTE A,B,C);
EXT PROCEDURE SEGSTAT;
EXT PROCEDURE OBJSTAT;
EXT BOOL PROCEDURE GIFONL(INTE PNTR,FLG; REF BOOL FLAG);
EXT PROCEDURE FNDEND;
EXT INTE PROCEDURE ENDFND(REF INTE OBJ);
EXT INTE PROCEDURE ENDNXT(REF INTE OBJ);
EXT PROCEDURE GLBDEL(ITEMVAR ARG);
COMMENT DEFINITIONS AND STORAGE ALLOCATION;
FORTRAN PROCEDURE DATGET;
FORTRAN PROCEDURE DATPUT;
DEFINE D1MAX="1500", STLEN="6",CRLF="'15&'12", ⊃="COMMENT",
SAFEX="SAFE",EXT="EXTERNAL",GETINT(X,Y)="GENTER(X,Y,GDUM1←DR,GDUM2)",
SQRING="1", OBJRNG="1", OUTLIN="2", PNTRNG="1", DISFRM="2",
PNTNUM="1", OBJNUM="3",OBJPNT="1", SEGRNG="1", SEGPNT="1", LIMIT="4",
CAMERA="8", CORPNT="1", WORLDR="2", SEGRNG="1";
SAFEX EXTERNAL SHORT INTEGER ARRAY STACK, COSTKX, COSTKY[1:STLEN];
EXTERNAL SAFEX SHORT INTEGER ARRAY DISPL1[1:D1MAX+5];
EXTERNAL REAL ORX, ORY, OCL, OSL, OD, OB, TOLTRA, TOLSCN,
D_LENG, CONF, DIF, CIRCLE, SPACE;
EXTERNAL BOOLEAN DISFLG, DEBUGX, ST;
EXTERNAL SHORT INTEGER XINCR, YINCR, TTHRES, XSTRT, YSTRT, TMAX,
BMAX, RSMAX, LSMAX, BITS, TOPLST, OBJLST, PNTLST, TEMPNT,
TEMPLT, SAITEM, SEGLST, TVCAM, DISPNT, TEMSAI, ACCOMINIT,
D_PTR, IND;
EXTERNAL STRING JOB;
SAFEX REAL ARRAY ITEMVAR CAMTRA;
SHORT INTEGER DELAY, TCOUNT, PROOBJ, LIML, LIMR, LIMT,LIMB, DEBCNT,
MANCNT, GDUM1, GDUM2, XSAV, YSAV, DR;
REAL CLDIV, MTOP, MBOT, MLEFT, MRIGHT, RADSQ;
BOOLEAN FLAG, DEBSOB;
INTERNAL BOOLEAN TRAC, EDGINIT,DEBDEL;
INTERNAL SHORT INTEGER OBJCNT, DEBFRM,DISTST, GTHRES;
INTERNAL REAL DIFF;
EXTERNAL SET FNDBLB;
comment variables:
XHOLD, YHOLD coordinates at start of object trace
TCOUNT number of points seen for this object
LIMT,LIMR,LIML,LIMB limits of fine raster scan
MTOP,MBOT,MLEFT,MRIGHT limits of object being scanned
definitions
SAFEX for SAFE arrays
STLEN length of coordinate stacks
;
SIMPLE INTERNAL PROCEDURE EDGTYP;
TYP_EDGE ← TRUE;
SIMPLE INTERNAL PROCEDURE CHANGE;
CHANGE_ACC←TRUE;
COMMENT DEBUGGING ROUTINES;
SIMPLE INTERNAL PROCEDURE EDGEON;
BEGIN SHORT INTEGER I;
IF DISDEV≠2 THEN
BEGIN
OUTSTR("NO DEBUGGING ON THIS DEVICE"&CRLF);
RETURN;
END;
IF DEBUGX∧DEBFRM≥0 THEN RELPOG(DEBFRM);
IF (DEBFRM ← GETPOG)≥0 THEN DEBUGX←TRUE ELSE
OUTSTR("NO FREE FRAMES - EDGEON"&CRLF);
SETFORMAT(0,0);
OPEN(14,"DSK",0,0,2,1000,I,I);
ENTER(14,"EDG"&CVS(RUN)&".DBG",I);
OUTSTR("DELAY?"&CRLF);
DEBDEL ← INCHWL="Y";
SETFORMAT(3,7);
END;
SIMPLE INTERNAL PROCEDURE EDGOFF;
BEGIN
DEBDEL ← DEBSOB ← DEBUGX ← FALSE;
RELEASE(14);
RELPOG(DEBFRM);
END;
DEFINE DEBOUT(A)="IF TYP_EDGE THEN OUTSTR(A&CRLF)";
COMMENT TIMING ROUTINES AND MISC. ROUTINES;
SHORT INTEGER DAYTIME, RUNTIME;
SIMPLE INTERNAL PROCEDURE TIMEIN;
BEGIN
DAYTIME ← CALL(0,"TIMER");
RUNTIME ← CALL(0,"RUNTIM");
END;
SIMPLE INTERNAL PROCEDURE TIMOUT;
BEGIN SHORT INTEGER I,J;
I ← CALL(0,"TIMER") - DAYTIME;
J ← CALL(0,"RUNTIM") - RUNTIME;
SETFORMAT(7,3);
OUTSTR("ELAPSED TIME="&CVF(I/60.0)&CRLF);
OUTSTR("RUN TIME="&CVF(J/1000.0)&CRLF);
END;
COMMENT ACCOMODATION LINKS;
SIMPLE INTEGER PROCEDURE AVINT(INTEGER X,Y);
BEGIN
IF DEBUGX THEN DPYPNT(X,Y);
RETURN((GETINT(X,Y-1)+GETINT(X,Y)+GETINT(X,Y+1)+.7)/3);
END;
EXT INTEGER PROCEDURE SCANINIT;
EXT BOOLEAN PROCEDURE XTENT(INTEGER X, Y, XINCR; BOOLEAN SIGFLAG);
EXT BOOLEAN PROCEDURE ACCOMO(INTEGER X, Y;REFERENCE INTEGER ANGLE, CW);
EXT BOOLEAN PROCEDURE DISCON(INTEGER INT,NINT,X,Y,Z,W);
EXT BOOLEAN PROCEDURE ACOMTEST(REFERENCE INTEGER INT,NINT;INTEGER X,Y,LX,LY);
EXT BOOLEAN PROCEDURE FINEAC(INTEGER X1,Y1,X2,Y2,INT,INT1);
EXT PROCEDURE REINIT;
SIMPLE INTEGER PROCEDURE SIGN(INTEGER A);
RETURN(IF A>0 THEN 1 ELSE IF A<0 THEN -1 ELSE 0);
⊃ TRUE IF POINT BLOCKS A AND B ARE FROM
DIFFERENT SEGMENTS;
SIMPLE BOOLEAN PROCEDURE SEGTST(SHORT INTEGER A,B);
BEGIN SHORT INTEGER I, J;
I ← J ← PNTRNG;
GUP(A, I, FLAG);
GUP(B, J, FLAG);
RETURN(A≠B);
END;
SIMPLE INTERNAL PROCEDURE TRACCHK;
BEGIN
IF TRAC≡DEB_EDGE THEN RETURN;
IF DEB_EDGE THEN
BEGIN
TRAC ← TRUE;
EDGEON;
DELAY ← FALSE;
END ELSE BEGIN
TRAC ← FALSE;
IF ¬DEBUGX THEN EDGOFF;
END;
END;
COMMENT YOPER RETURNS GLOBALS AS FOLLOWS:
VALUE <0 IF OUTSIDE FIELD OF VIEW
VALUE=0 IF EDGE LOST
ORX,ORY CENTER OF EDGE
ANGLE DIRECTION NUMBER
OD INTENSITY ON LEFT SIDE OF EDGE
OB INTENSITY ON RIGHT SIDE OF EDGE
OWID WIDTH OF EDGE (-1 IF UNKNOWN)
OGRAD MAXIMUM GRADIENT (-1 FOR MANFRED);
comment variables:
CW 1 to trace with operator direction vector, -1 to rotate 180
ANGLE direction number for moving tv input
WRITMES TRUE until display overflow message is typed
ACCOMF TRUE is accomodation routines called for this point
LEFT TRUE if background on left of scan vector
REPFLG TRUE if last point found was on stack
;
⊃ REGENERATE AS MUCH DISPLAY AS NECESSARY;
INTERNAL PROCEDURE REGEN(SHORT INTEGER OBJ);
BEGIN SHORT INTEGER PNTR, TST, FRAM, FLAG, FLD, I,J;
LABEL III;
SET S, Z, PTS;
ITEMVAR A;
SAFEX REAL ARRAY ITEMVAR P;
PROCEDURE DISP;
BEGIN DEFINE ∂="GLOBAL DATUM";
FRAM ← GGETD(PNTR,DISFRM,FLAG);
IF FRAM<0 THEN RETURN;
CLRBFR;
FADCHG(0,0,AIVECT);
A ← CVI(GGETD(PNTR,OBJNUM,FLAG));
S ← Z ← GLOBAL LINE⊗A;
WHILE LENGTH(Z) DO
BEGIN "DPY"
PTS ← GLOBAL ENDPT⊗LOP(Z);
P ← LOP(PTS);
FRDCHG(∂(P)[1],∂(P)[2],RIVECT);
P ← LOP(PTS);
FRDCHG(∂(P)[1],∂(P)[2],RVECT);
END "DPY";
Z ← GLOBAL DANGLE⊗A;
S ← S∪Z;
IF LENGTH(Z) THEN
BEGIN "DANGLE" SHORT INTEGER I,L;
P ← LOP(Z);
L ← ARRINFO(∂(P),2);
FOR I←1 STEP 1 UNTIL L DO
BEGIN
FRDCHG(∂(P)[I,1],∂(P)[I,2],RIVECT);
FRDCHG(∂(P)[I,3],∂(P)[I,4],RVECT);
END;
END "DANGLE";
IF ¬LENGTH(S)∨DEBUGX THEN
DISFLG ← PLTPNT(PNTR,DISPL1[2]);
DPYOUT(FRAM);
END;
IF DISTST<0∨DISFLG THEN RETURN;
IF DISDEV=2 THEN GO TO III;
IF DISDEV≠3 THEN RETURN;
FLD ← 1;
PNTR ← TOPLST;
GDOWN(PNTR,FLD,FLAG);
IF FLAG THEN RETURN;
TST ← PNTR LAND '777777;
DO BEGIN "EACH"
IF ¬(PNTR LAND '777777)=OBJ THEN DISP;
GFORWR(PNTR,FLD,FLAG);
END "EACH" UNTIL (PNTR LAND '777777)=TST;
III: IF OBJ>0 THEN
BEGIN "LAST"
PNTR ← OBJ;
DISP;
IF DISFLG THEN OUTSTR("DPY TURNED OFF"&CRLF);
END "LAST";
END;
COMMENT HOUSEKEEPING TASKS COMMON TO PNTMOV AND PNTCOP;
SIMPLE PROCEDURE PNTSET(SHORT INTEGER NEWOBJ, NEWSEG;
REFERENCE ITEMVAR ARG);
BEGIN SHORT INTEGER NEWN, FLD, I, J, OLDN, TEMP, NNEW;
REAL MT,MB,ML,MR;
NEWN ← GGETD(OBJLST,OBJNUM,FLAG);
IF GSTATO(8,OBJLST,FLAG) THEN GULINK(OBJLST,CORPNT,FLAG);
GRSETS(32,SEGLST,FLAG);
GRSETS(64+32+8+2,OBJLST,FLAG);
OLDN ← GGETD(OBJLST,PNTNUM,FLAG);
NNEW ← GGETD(NEWOBJ,PNTNUM,FLAG);
GSTORD(TCOUNT←OLDN+NNEW,OBJLST,PNTNUM,FLAG);
IF (I←GGETD(NEWOBJ,DISFRM,FLAG))≥0 THEN RELPOG(I);
IF (I ← GCOUNT(NEWOBJ,OUTLIN,FLAG))>0 THEN
BEGIN
FLD ← SEGRNG;
FOR J ← 1 STEP 1 UNTIL I DO
BEGIN
TEMPLT ← NEWSEG;
GFORWR(NEWSEG,SEGRNG,FLAG);
GULNKR(TEMPLT,SEGRNG,FLAG);
GLINKR(SEGLST,SEGRNG,TEMPLT,SEGRNG,FLAG);
END;
END;
DATGET(OBJLST,LIMIT,4,MT,MB,ML,MR);
IF MT<MTOP THEN MTOP ← MT;
IF MB>MBOT THEN MBOT ← MB;
IF ML<MLEFT THEN MLEFT ← ML;
IF MR>MRIGHT THEN MRIGHT ← MR;
IF NEWN=PROOBJ THEN
BEGIN
LIMT←MTOP; LIMB←MBOT;
LIMR←MRIGHT; LIML←MLEFT;
END;
IF CAMTRA≠NIL THEN GLOBAL DELETE(CAMTRA);
CAMTRA ← CVI(GGETD(OBJLST,CAMERA,FLAG));
GKILBL(NEWOBJ,FLAG);
RENUM(NEWN,CVN(ARG));
GLOBAL DELETE(ARG);
ARG ← CVI(NEWN);
GLBDEL(ARG);
TEMP ← SEGLST;
IF DISTST≥0 THEN
BEGIN
REGEN(OBJLST);
DISPNT ← GGETD(OBJLST,DISFRM,FLAG);
END;
SEGLST ← TEMP;
OBJSTAT;
END;
COMMENT COPY A SEGMENT TO NEW OBJECT;
SIMPLE PROCEDURE PNTMOV(SHORT INTEGER OLDPNT; REFERENCE ITEMVAR ARG);
BEGIN SHORT INTEGER PNTR, FLD, FLAG;
PNTR ← OLDPNT;
FLD ← PNTRNG;
GUP(PNTR,FLD,FLAG);
TEMPLT ← SEGLST;
GFORWR(SEGLST,SEGRNG,FLAG);
GULNKR(TEMPLT,SEGRNG,FLAG);
GLINKR(PNTR,SEGRNG,TEMPLT,SEGRNG,FLAG);
TEMPLT↔SEGLST;
TEMPNT←OBJLST;
FLD ← SEGRNG;
OBJLST ← SEGLST;
GUP(OBJLST,FLD,FLAG);
PNTSET(TEMPNT,TEMPLT,ARG);
END;
COMMENT COPY POINT BLOCKS TO NEW OBJECT;
SIMPLE PROCEDURE PNTCOP(SHORT INTE OLDPNT;REF ITEMVAR ARG; BOOL SAMEOBJ);
BEGIN SHORT INTEGER NEWOBJ, J, I, PTR, NEWSEG, CNT, CWF, DIR;
NEWOBJ ← OBJLST;
J ← PNTRNG;
OBJLST ← OLDPNT;
GUP(OBJLST, J, FLAG);
TEMPLT ← NEWSEG ← SEGLST;
SEGLST ← OBJLST;
GUP(OBJLST,J,FLAG);
J ← PNTRNG;
CNT ← GCOUNT(NEWSEG, SEGPNT, FLAG);
DIR ← GSTATO(8,OLDPNT,FLAG);
CWF ← GSTATO(8,PNTLST,FLAG);
GRSETS(IF DIR THEN 15 ELSE 23, OLDPNT, FLAG);
GRSETS(IF CWF THEN 15 ELSE 23,PNTLST,FLAG);
J ← PNTRNG;
IF ¬DIR THEN GBACK(OLDPNT,J,FLAG);
FOR I ← 1 STEP 1 UNTIL CNT DO
BEGIN
PTR ← PNTLST;
IF CWF THEN GBACK(PNTLST,J,FLAG) ELSE GFORWR(PNTLST,J,FLAG);
GULNKR(PTR,J,FLAG);
GLINKR(OLDPNT,PNTRNG,PTR,PNTRNG,FLAG);
IF DIR THEN GFORWR(OLDPNT,J,FLAG);
END;
GFORWR(NEWSEG,SEGRNG,FLAG);
GKILBL(TEMPLT,FLAG);
GRSETS(24,PTR,FLAG);
GSETST(IF DIR THEN 8 ELSE 16, PTR, FLAG);
IF ¬SAMEOBJ THEN PNTSET(NEWOBJ, NEWSEG, ARG);
END;
COMMENT EDGE FOLLOWER ENTRY STARTS HERE;
INTERNAL BOOL PROCEDURE EDGE_KKP(REF ITEMVAR ARG;REF INTE STATUS);
BEGIN "EDGE"
SHORT INTEGER X, Y, LL, RL, TL, BL, INT, NINT, I, J,
ANGLE, PNTR, PTRA, SDLEN;
ITEMVAR TARG, TEMPARG;
LABEL ENDLAB;
INTERNAL REAL SIDLEN;
INTERNAL BOOLEAN EINIT;
⊃ CHECKS CONSECUTIVE POINTS OF RASTER SCAN FOR AN EDGE AND
DECIDES IF IT SHOULD BE TRACED. X,Y IS THE CURRENT POINT.
XINCR,YINCR ARE THE X AND Y INCREMENTS. F IS TRUE IF
HORIZONTAL SCAN, FALSE FOR VERTICAL. INNER IS TRUE IF
THE EDGE SHOULD BE TRACED. ;
SIMPLE BOOL PROCEDURE INNER(SHORT INTE XINCR; REF SHORT INTE X,
Y, XYSTR);
BEGIN SHORT INTEGER INC, PNTR, SEENVAL;
BOOLEAN SEETST, ACCOM,TRAC;
REAL A, B, C, X1, X2, Y1, Y2, XN;
LABEL L3, L5;
SEETST ← TRAC ← FALSE;
ACCOM ← TRUE;
L3: NINT ← AVINT(X, Y);
IF ¬ST∧¬(0<INT<15∧0<NINT<15)∧ACCOM∧ABS(INT-NINT)<12
∧ACOMTEST(INT,NINT,X,Y,X-XINCR,Y) THEN
BEGIN
ACCOM ← FALSE;
INT ← AVINT(X-XINCR,Y);
GO TO L3;
END;
IF ¬DISCON(INT,NINT,X-XINCR,Y,X,Y) THEN RETURN(TRAC);
INC ← SIGN(XINCR)*(CIRCLE+1);
ACCOM ← TRUE;
EJINIT(2);
L5: FOR I ← X-XINCR STEP INC UNTIL X DO
IF YOPER(I,Y,ANGLE,0,FALSE,-1)≥1 THEN
IF ¬(SEENVAL←SEETST←SEEN(ORX,ORY,TOLSCN,PNTR)) THEN
BEGIN
TRAC ← XTENT(X,Y,XINCR,(NINT-INT)>0);
IF TYP_EDGE THEN OUTSTR("XTENT "&
(IF TRAC THEN "OK" ELSE "FAILED")&CRLF);
IF TRAC THEN X←I;
RETURN(TRAC);
END ELSE I←I+3*INC;
IF ¬SEETST THEN IF ¬ST∧¬ACCOM∧(ACCOM←
FINEAC(X-XINCR,Y,X,Y,INT,NINT)) THEN
GO TO L5 ELSE RETURN(TRAC);
I ← SEGPNT;
GDOWN(PNTR,I,FLAG);
PTRA←(PNTR←PNTR LAND '777777);
IF GIFTYP(CVSIX("LINE"),PNTR,FLAG) THEN DO
BEGIN "COMPACTED"
DATGET(PTRA,1,7,A,B,C,X1,Y1,X2,Y2);
IF A≠0 THEN
BEGIN
XN←-(B*Y+C)/A;
IF Y1≤Y≤Y2∧(XN-X)*XINCR>0 THEN
XYSTR←X←XN+4*SIGN(XINCR);
END;
GFORWR(PTRA,I←SEGPNT,FLAG);
END "COMPACTED" UNTIL PNTR=(PTRA LAND '777777);
NINT ← AVINT(X,Y);
RETURN(TRAC);
END;
⊃ initialize edge following routines;
SIMPLE PROCEDURE INITIAL;
BEGIN SHORT INTEGER N;
EJINIT(2);
RADSQ ← CIRCLE↑2;
GTHRES ← (TTHRES + (CASE BITS-3 OF (-4,0,4,4))) MAX 2;
CLDIV ← CASE BITS-3 OF (64.0, 128.0, 256.0, 512.0);
SEINT(SDLEN←(SIDLEN←(CIRCLE*1.5) MIN (SPACE MAX 1.0))+.5,
STLEN,STACK[1],COSTKX[1],COSTKY[1]);
DIFF ← (DIF*(CASE BITS-3 OF (1.0,1.0,2.0,2.0)))↑2;
INTPNT;
IF ¬ST THEN
BEGIN
CWHEEL(6);
IF (COLFILT_ACC←IND)≠3 THEN
BEGIN
CWHEEL(COLFILT_ACC←3);
N←12000;
WHILE N>0 DO N←N-1;
END;
IF ¬FIL_ACC[COLFILT_ACC] THEN
BEGIN
CHANGE_ACC←TRUE;
SCANINIT;
FIL_ACC[COLFILT_ACC]←AUTO_ACC;
END;
END;
EDGINIT ← TRUE;
END;
COMMENT TRACE AROUND AN OBJECT. TRUE IF AN EDGE TRACED;
INTERNAL SIMPLE BOOL PROCEDURE TRACE(SHORT INTE X, Y;
REF ITEMVAR ARG; REF SHORT INTE STATUS);
BEGIN "OUTER"
SHORT INTEGER CW, I, J, K, SEENVAL, DISCNTR, RET, REDOFL;
BOOLEAN ACCOMF, CWF, MORE, FLAG, REPFLG, WRITMES,MOV1,RETUR;
REAL TX, TY, TSL, TCL, TTY, TTX;
LABEL L1, L2, L5, OUTLAB, L6, OUTSID,L7, LOST, L4, L3, REDO,
REVERS, L13, L8, LEP, BACK, DELOBJ, REV1, REDOMC;
⊃ initialize scan variables;
MTOP ← MLEFT ← 350.0;
MBOT←MRIGHT←DEBCNT←MANCNT←STATUS←TCOUNT ← 0;
RETUR ← WRITMES ← TRUE;
REPFLG ← ACCOMF ← FALSE;
DISCNTR ← DISTST;
ORX ← X;
ORY ← Y;
CW ← 1;
IF ¬ST THEN ACCOMO(X,Y,ANGLE,CW);
⊃ initialize data structure and display;
IF ARGεOLDBLOB THEN REMOVE ARG FROM OLDBLOB ELSE
ARG ← GLOBAL NEW;
OBJCNT ← CVN(ARG);
IF DISTST≥0∧¬(DISFLG←(DISPNT←GETPOG)<0) THEN
BEGIN
CLRBFR;
FADCHG(X,Y,AIVECT);
END ELSE BEGIN
OUTSTR("NO FREE FRAMES - EDGE"&CRLF);
DISFLG ← TRUE;
END;
TEMPNT ← GCREBL(CVSIX("OBJECT"), FLAG);
IF GIFTIE(TOPLST,OBJPNT,FLAG) THEN
GLINKR(OBJLST,OBJRNG,TEMPNT,OBJRNG,FLAG)
ELSE GCRERI(TOPLST,OBJPNT,TEMPNT,OBJRNG,FLAG);
SEGLST ← GCREBL(CVSIX("SEGMNT"),FLAG);
GCRERI(OBJLST←TEMPNT,OUTLIN,SEGLST,SEGRNG,FLAG);
TEMSAI ← GCREBL(CVSIX("POINT"),FLAG);
GSETST(16+8,TEMSAI,FLAG);
PNTLST ← -1;
CAMTRA←IF YES_CAM THEN GLOBAL NEW(CAMERA_MODEL) ELSE NIL;
GSTORD(IF DISFLG THEN -1 ELSE DISPNT,OBJLST, DISFRM, FLAG);
GSTORD(OBJCNT, OBJLST, OBJNUM, FLAG);
GSTORD(CVN(CAMTRA),OBJLST,CAMERA,FLAG);
⊃ beginning of trace loop
- move and apply operator to predicted edge location;
L1: TTX ← ORX;
TTY ← ORY;
BACK: ANGLE ← (ANGLE+(IF CW>0 THEN 0 ELSE 4)) MOD 8;
TX ← ORX;
TY ← ORY;
TSL ← OSL;
TCL ← OCL;
REDOFL ← FALSE;
IF MANCNT>0 THEN MANCNT ← MANCNT-1;
X ← (ORX ← ORX-SIDLEN*OSL*CW)+.5;
Y ← (ORY ← ORY+SIDLEN*OCL*CW)+.5;
IF DEBUGX THEN OUT(14,"L1: X="&CVF(ORX)&" Y="&CVF(ORY)&
" DX="&CVF(TX-X)&" DY←"&CVF(TY-Y)&CRLF);
REDO: RET ← YOPER(X, Y, ANGLE, CW, TRUE,0);
IF REDOFL THEN EJINIT(2);
CASE RET+1 OF
BEGIN "CHKOP"
⊃ if point is outside field of view terminate scan and try to continue scan
from other end of segment traced;
OUTSID: BEGIN "OUTSID"
IF ¬REDOFL THEN GO TO REDOMC;
DEBOUT("""KKP: SCAN OUTSIDE""");
GSETST(4,IF PNTLST>0 THEN PNTLST ELSE TEMSAI,FLAG);
GO TO LOST;
END "OUTSID";
⊃ accomodate if edge was lost;
BEGIN "ACCOMO"
IF ¬ST∧¬ACCOMF∧(ACCOMF←ACCOMO(X,Y,ANGLE,CW)) THEN
GO TO L2 ELSE
IF ¬REDOFL THEN
REDOMC: BEGIN
EJINIT(1);
REDOFL ← TRUE;
GO TO REDO;
END ELSE DEBOUT("""EDGE LOST""");
END "ACCOMO";
⊃ jump over point if noisy;
IF REDOFL THEN GO TO LEP ELSE GO TO REDOMC;
⊃ if edge if found, test if seen before at this location.
If scan is looping, try to jump over bad area;
GO TO L2;
BEGIN "FOUND"
L2: IF (SEENVAL←SEEN(ORX,ORY,TOLTRA,PNTR))≥0 THEN
GO TO L5 ELSE
L3: IF REPFLG THEN
L4: IF MANCNT≤0 THEN
BEGIN
DEBOUT("""KKP:LOOPING""");
GO TO LOST;
END ELSE GO TO BACK ELSE BEGIN
IF ¬REDOFL THEN GO TO REDOMC;
X←TX;
Y←TY;
OSL←TSL;
OCL←TCL;
REPFLG ← MANCNT ← 2;
GO TO BACK;
END;
END "FOUND";
END "CHKOP";
⊃ if accomodation fails, try scanning around predicted position or
jumping over it;
LEP: MOV1 ← TRUE;
REPFLG ← FALSE;
TX ← TTX;
TY ← TTY;
TTX ← X-SIDLEN*TSL*CW;
TTY ← Y+SIDLEN*TCL*CW;
IF YOPER(TTX+.5,TTY+.5,ANGLE,CW,FALSE,0)≥2∧
(SEENVAL←SEEN(ORX,ORY,TOLTRA,PNTR))≥0 THEN GO TO L5;
L8: FOR J←-1,1 DO
BEGIN
RET ← YOPER(TTX+SIDLEN*J*TCL+.5,TTY+SIDLEN*J*TSL+.5,
ANGLE,CW,FALSE,0);
IF RET≥2∧(SEENVAL←SEEN(ORX,ORY,TOLTRA,PNTR))≥0 THEN
GO TO L5;
END;
IF MOV1 THEN
BEGIN
MOV1 ← FALSE;
TTX ← TX;
TTY ← TY;
GO TO L8;
END;
⊃ cannot find edge again;
IF REPFLG THEN GO TO L4;
⊃ this keeps loop processing from terminating early;
DEBOUT("""KKP: ACCOM FAILED""");
⊃ if no points seen yet, then the edge did not exist - flush data structure;
LOST: IF ¬TCOUNT THEN
BEGIN
DEBOUT("""KKP: NO POINTS""");
GO TO L7;
END;
⊃ check if we are near any other edges we can link to
(a possible cause of failure);
IF ((SEENVAL←SEEN(X,Y,TOLTRA,PNTR))>0)∧TCOUNT THEN
IF GIFTYP(CVSIX("SEGMNT"),PNTR,FLAG) THEN GO TO L7
ELSE GO TO L6;
IF DEBUGX THEN OUT(14,"LINKUP"&CRLF);
PNTR←ENDFND(SEENVAL);
WHILE PNTR>0∧PNTR≠PNTLST DO
BEGIN "TEST"
DATGET(PNTR,1,2,TTX,TTY);
IF (TTX-TX)↑2+(TTY-TY)↑2<(CIRCLE*2.0)↑2 THEN
GO TO L6;
PNTR ← ENDNXT(SEENVAL);
END "TEST";
IF GSTATO(6,IF PNTLST>0 THEN PNTLST ELSE TEMSAI,FLAG) THEN
GO TO REVERS;
⊃ terminate segment and reverse to try to scan from other
end, if it is not attached to anything;
GSETST(1,IF PNTLST>0 THEN PNTLST ELSE TEMSAI,FLAG);
REVERS: IF PNTLST>0 THEN
BEGIN
IF ¬GETEND(SEGLST,I,J) THEN
USERERR(0,0,"NO STATUS BITS-REVERSE");
PNTLST ← IF PNTLST=I THEN J ELSE I;
END;
REV1: IF (PNTLST>0∧GSTATZ(7,PNTLST,FLAG))∨
(PNTLST<0∧GSTATZ('100,TEMSAI,FLAG)) THEN
BEGIN "REVERS"
IF ¬(MORE ← PNTLST>0) THEN GSETST('100,TEMSAI,FLAG);
TEMPNT ← IF MORE THEN PNTLST ELSE TEMSAI;
DEBOUT("""SCAN REVERSED - EDGE""");
I ← GSTATO(8,TEMPNT,FLAG);
J ← GSTATO(16,TEMPNT,FLAG);
CW ← IF I∧J THEN -CW ELSE IF I THEN 1 ELSE -1;
MANCNT ← REPFLG ← ACCOMF ← FALSE;
SAITEM ← TEMPNT;
J ← PNTRNG;
FOR K←STLEN STEP -1 UNTIL 1 DO
IF ¬MORE THEN COSTKX[K]←COSTKY[K]←STACK[K]←-1
ELSE BEGIN "RESTACK"
COSTKX[K] ← FOOLX(GGETD(SAITEM,1,FLAG));
COSTKY[K] ← FOOLX(GGETD(SAITEM,2,FLAG));
STACK[K] ← SAITEM LAND '777777;
IF GSTATO(IF CW>0 THEN 16 ELSE 8,SAITEM,FLAG)
THEN MORE←FALSE ELSE
IF CW>0 THEN GBACK(SAITEM,J,FLAG)
ELSE GFORWR(SAITEM,J,FLAG);
END "RESTACK";
ORX ← FOOLX(GGETD(TEMPNT,1,FLAG));
ORY ← FOOLX(GGETD(TEMPNT,2,FLAG));
OCL ← FOOLX(GGETD(TEMPNT,3,FLAG));
OSL ← FOOLX(GGETD(TEMPNT,4,FLAG));
GRSETS(1,TEMPNT,FLAG);
GO TO L1;
END "REVERS";
⊃ if segment is too small, delete it.
Otherwise, go to update data structure;
IF TCOUNT<4 THEN
BEGIN
DEBOUT("""KKP: OBJECT TOO SMALL""");
L7: REJSUB(ARG,I);
DEBOUT("""DELETED""");
GLOBAL DELETE(ARG);
ARG ← NIL;
RETUR ← FALSE;
GO TO OUTLAB;
END;
GO TO L13;
⊃ edge found, check seen before conditions for posible rejection of line
and update display;
L5: IF SEENVAL∧¬TCOUNT THEN
BEGIN
DEBOUT("""KKP:POINT SEEN BEFORE""");
GO TO L7;
END;
IF SEENVAL∧GIFTYP(CVSIX("SEGMNT"),PNTR,FLAG) THEN GO TO L7;
IF SEENVAL THEN IF ¬REDOFL THEN GO TO REDOMC ELSE
BEGIN REDOFL ← FALSE; GO TO L6; END;
IF REDOFL THEN
BEGIN DEBOUT("""OPER 1 WON !!""");REDOFL←FALSE;END;
IF ¬DISFLG THEN IF DEBUGX THEN FADCHG(ORX,ORY,APOINT) ELSE
FRDCHG(ORX,ORY,RPOINT);
IF ¬(DISCNTR←DISCNTR-1)∨DEBUGX THEN
BEGIN
DPYOUT(DISPNT);
DISCNTR←DISTST;
END;
IF (DISFLG←DISPL1[2]>D1MAX)∧WRITMES THEN
BEGIN
WRITMES ← FALSE;
OUTSTR(CRLF&"DISPLAY TURNED OFF"&CRLF);
END;
⊃ update internal data structures for the new point
and return for next point;
TCOUNT ← TCOUNT+1;
DATPUT(TEMSAI,1,4,ORX,ORY,OCL,OSL);
J ← PNTRNG;
IF MTOP>ORY THEN MTOP ← ORY;
IF MBOT<ORY THEN MBOT ← ORY;
IF MLEFT>ORX THEN MLEFT ← ORX;
IF MRIGHT<ORX THEN MRIGHT ← ORX;
IF PNTLST>0 THEN PTPNT(TEMSAI) ELSE
GCRERI(SEGLST,SEGPNT,PNTLST←TEMSAI,J,FLAG);
TEMSAI ← GCREBL(CVSIX("POINT"),FLAG);
GSTORD(GGETD(OBJLST,PNTNUM,FLAG)+1,OBJLST,PNTNUM,FLAG);
ADJSTK(STACK[1],COSTKX[1],COSTKY[1]);
STACK[STLEN] ← PNTLST LAND '7777777;
COSTKX[STLEN] ← X ← ORX;
COSTKY[STLEN] ← Y ← ORY;
PTINIT(X, Y);
REPFLG ← ACCOMF ← FALSE;
GO TO L1;
⊃ another segment hit while scanning. Either merge segments or objects,
or delete new segment;
L6: IF GSTATO(24,PNTR,FLAG) THEN
BEGIN "ENDFND"
IF OBJCNT=SEENVAL∧¬SEGTST(PNTR,PNTLST) THEN
BEGIN "SAMOBJ"
GRSETS(16+8+7,PNTR,FLAG);
GRSETS(16+8+7,PNTLST,FLAG);
DEBOUT("""SEGMENT CLOSED""");
END "SAMOBJ" ELSE BEGIN "DIFOBJ"
PNTCOP(PNTR,ARG,OBJCNT=SEENVAL);
OBJCNT ← CVN(ARG);
DEBOUT("""MERGED SEGMENTS""");
END "DIFOBJ";
END "ENDFND" ELSE BEGIN "NOTEND"
IF OBJCNT≠SEENVAL THEN
BEGIN
PNTMOV(PNTR, ARG);
OBJCNT ← CVN(ARG);
END;
DEBOUT("""HIT ANOTHER SEGMENT""");
GSETST(2, PNTLST, FLAG);
END "NOTEND";
⊃ end of this segment, update data structure and return
if still loose ends to check;
L13: IF GETEND(SEGLST,I,J) THEN
BEGIN "CHKENDS"
IF PNTLST≠I∧PNTLST≠J THEN USERERR(0,0,"IGL PNTLST");
PNTLST ← IF PNTLST=I THEN J ELSE I;
IF GSTATZ(7,PNTLST,FLAG) THEN GO TO REV1;
SEGSTAT;
END "CHKENDS" ELSE
START_CODE MOVEI 2,7; ANDCAM 2,@SEGLST; END;
⊃ delete object or segment if too small;
IF (J←GCOUNT(SEGLST,SEGPNT,FLAG))<3 THEN
BEGIN "TOSMAL" SHORT INTEGER SALL;
IF GIFONL(SEGLST,SEGRNG,FLAG) THEN GO TO DELOBJ;
PNTLST ← SEGLST;
GDOWN(PNTLST,SALL←SEGPNT,FLAG);
FOR I←1 STEP 1 UNTIL J DO
BEGIN "KILPNT"
PNTR ← PNTLST;
GFORWR(PNTLST,SALL←PNTRNG,FLAG);
GULNKR(PNTR,PNTRNG,FLAG);
IF GIFONL(PNTR,WORLDR,FLAG) THEN
BEGIN "KILWOR" SHORT INTEGER SUP;
SAITEM ← PNTR;
GUP(SAITEM,SUP←WORLDR,FLAG);
IF GIFONL(SAITEM,SQRING,FLAG) THEN
BEGIN "KILLNK" INTEGER I,J;
TEMPNT ← SAITEM;
GUP(TEMPNT,SUP←SQRING,FLAG);
J ← GGETD(TEMPNT,1,FLAG);
START_CODE
MOVE 1,@J;
SETZM @J;
MOVEM 1,I;
END;
GKILBL(I,FLAG);
TEMPNT ← GKILBL(TEMPNT,FLAG);
END "KILLNK";
GULNKR(SAITEM,SQRING,FLAG);
SAITEM←GKILBL(SAITEM,FLAG);
END "KILWOR";
GULNKR(PNTR,WORLDR,FLAG);
PNTR ← GKILBL(PNTR,FLAG);
END "KILPNT";
PNTR ← SEGLST;
GBACK(SEGLST,SEGRNG,FLAG);
PNTR ← GKILBL(PNTR,FLAG);
RETUR ← FALSE;
END "TOSMAL";
⊃ update object status and terminate trace procedure;
OBJSTAT;
SETFORMAT(0,0);
IF ¬DISFLG THEN
BEGIN
RIVECT(-10,0);
DPYSST(CVS(OBJCNT));
DPYOUT(DISPNT);
END;
PUT ARG IN FNDBLB;
IF TCOUNT<4 THEN
DELOBJ: BEGIN
DEBOUT("""OBJECT TOO SMALL""");
GO TO L7;
END;
DATPUT(OBJLST,LIMIT,4,MTOP,MBOT,MLEFT,MRIGHT);
OUTLAB: TEMPNT←TEMPLT←SEGLST←SAITEM←PNTLST←TEMSAI←-1;
FOR I←1 STEP 1 UNTIL STLEN DO STACK[I]←-1;
RETURN(RETUR);
END "OUTER";
⊃ HORIZONTAL SCAN FOR OBJECT TO TRACE - TRUE IF NONE FOUND;
SIMPLE INTERNAL BOOL PROCEDURE XSCAN(BOOL FLAG;SHORT INTE TOP,BOT,LEFT,RIGHT,
XINCR,YINCR;REF ITEMVAR ARG;REF SHORT INTE STATUS,X,Y);
BEGIN SHORT INTEGER TINCR,XSTR, J, K;
BOOLEAN FL;
LABEL NOCHECK;
IF ¬EDGINIT THEN INITIAL;
DR ← -1;
FOR I←1 STEP 1 UNTIL STLEN DO COSTKX[I] ← COSTKY[I] ← STACK[I] ← -1;
TINCR ← -YINCR;
J ← SDLEN*SIGN(TINCR);
K ← SDLEN*SIGN(XINCR);
IF ¬EINIT THEN
BEGIN
EINIT←TRUE;
X←XSTRT;
Y←YSTRT;
NINT←AVINT(X,Y);
GO TO NOCHECK;
END;
FOR Y ← BOT+J STEP TINCR UNTIL TOP-J DO
BEGIN
INT ← AVINT(LEFT+K,Y);
FOR X ← LEFT+K STEP XINCR UNTIL RIGHT-K DO
BEGIN
XSTR ← X;
IF INNER(XINCR,X,Y,XSTR) THEN
BEGIN
FL ← TRACE(X,Y,ARG,STATUS);
REINIT;
X ← X+XINCR;
IF FL∧FLAG THEN RETURN(FALSE);
END ELSE X ← XSTR;
NOCHECK: INT ← NINT;
END;
END;
RETURN(TRUE);
END;
COMMENT FINE SCAN AREA USING MANFRED OPERATOR FOR EDGE
DETECTION - TRUE IS NOTHING FOUND;
SIMPLE INTERNAL BOOL PROCEDURE OPSCAN(REF ITEMVAR ARG;
REF SHORT INTE STATUS,EINIT;SHORT INTE T,B,LL,R);
BEGIN BOOLEAN FL,AC;
SHORT INTEGER INCR, I, J, K, L, X, Y, TOP, BOT, LEFT, RIGHT, NIN,
OIB, OID, SEENVAL, RET;
IF ¬EDGINIT THEN INITIAL;
BOT ← B;
LEFT ← LL;
SENSFLAG_ACC←TRUE;
FOR I ← 1 STEP 1 UNTIL STLEN DO COSTKX[I]←COSTKY[I]←STACK[I]←-1;
J ← (INCR ← CIRCLE);
IF EINIT THEN BEGIN K←BOT-J;L←LEFT+J; EINIT←FALSE;END ELSE
BEGIN K←YSTRT; L←XSTRT; END;
TOP ← T+J;
RIGHT ← R-J;
NIN ← -INCR;
FOR Y←K STEP NIN UNTIL TOP DO
BEGIN
FOR X←L STEP INCR UNTIL RIGHT DO
BEGIN LABEL LOOP;
AC ← FALSE;
LOOP: IF (RET←YOPER(X,Y,I,0,FALSE,-1))≥1∧
¬(SEENVAL←SEEN(ORX,ORY,TOLTRA,I)) THEN
BEGIN
FL ← TRACE(X,Y,ARG,STATUS);
XSTRT ← X;
YSTRT ← Y;
REINIT;
XSTRT ← X ← X+INCR;
IF FL THEN RETURN(FALSE);
END ELSE
IF ¬ST∧RET≤1∧((OB MAX OD)<GTHRES∨
(OD MIN OB)>15-GTHRES)∧¬AC∧
(AC←ACOMTEST(OIB←OB,OID←OD,X-OCL*2.0
,Y-OSL*2.0,X+OCL*2.0,Y+OSL*2.0))
THEN GO TO LOOP;
END;
L ← LEFT+J;
END;
RETURN(TRUE);
END;
COMMENT OUTPUT STATUS INFO TO CALLING JOB FOR EACH OBJECT;
SIMPLE INTERNAL PROCEDURE OUTOBJ(REFERENCE SHORT INTEGER STATUS);
BEGIN LABEL L25, L21, L1, L26;
OBJLST ← TOPLST;
I ← OBJPNT;
GDOWN(OBJLST,I,FLAG);
IF FLAG THEN
BEGIN
OBJLST ← -1;
GO TO L26;
END;
TEMPLT ← OBJLST;
L21: IF GSTATO(64,OBJLST,FLAG) THEN
BEGIN
L1: GFORWR(OBJLST,I,FLAG);
IF TEMPLT≠OBJLST THEN GO TO L21 ELSE
BEGIN
L26: TEMPLT ← SEGLST ← -1;
RETURN;
END;
END;
GSETST(64,OBJLST,FLAG);
STATUS ← 0;
SEGLST ← OBJLST;
I ← OUTLIN;
GDOWN(SEGLST,I,FLAG);
J ← SEGLST;
L25: START_CODE DEFINE MOVE="'200000000000";
MOVE 2,SEGLST;
HRRZ 2,(2);
ANDI 2,7;
IORM 2,STATUS;
END;
GFORWR(SEGLST,I,FLAG);
IF SEGLST≠J THEN GO TO L25;
IF GSTATO(7,OBJLST,FLAG) THEN STATUS ← STATUS +'100;
IF EQU(JOB,"TTY") THEN
OUTSTR("FIND "&CVS(GGETD(OBJLST,OBJNUM,FLAG))&" "&
CVOS(STATUS)&CRLF) ELSE
ISSUE(5,"EDGE",JOB,MESSAGE RESPONSE("FIND",
GGETD(OBJLST,OBJNUM,FLAG),STATUS));
GO TO L1;
END;
COMMENT SEARCH DATA STRUCTURE FOR DANGLING SEGMENT ENDS;
PROCEDURE FNDPNT(REFERENCE ITEMVAR ARG; REFERENCE SHORT INTEGER STATUS);
BEGIN LABEL L1;
ITEMVAR CURNUM;
REAL X,Y;
SHORT INTEGER LIMB,LIMT,LIML,LIMR,DEBF,TEST;
CURNUM ← CVI(GGETD(OBJLST,OBJNUM,FLAG));
IF DEBUGX THEN DEBF←GETPOG;
L1: IF (TEST ← GETOBJ(CURNUM,FALSE,OBJLST))>0 THEN OBJLST←TEST;
TEMPLT ← -1;
FNDEND;
TEST ← TRUE;
IF TEMPLT>0 THEN
BEGIN
GSETST(32,TEMPLT,FLAG);
DATGET(TEMPLT,1,2,X,Y);
LIMT ← IF Y-10<TMAX+2 THEN TMAX+2 ELSE Y-10;
LIMB ← IF Y+10>BMAX-2 THEN BMAX-2 ELSE Y+10;
LIML ← IF X-10<LSMAX+2 THEN LSMAX+2 ELSE X-10;
LIMR ← IF X+10>RSMAX-2 THEN RSMAX-2 ELSE X+10;
IF DEBUGX THEN
BEGIN "DEB"
INTEGER DSAVE;
SAFEX INTEGER ARRAY DBUF[1:50];
DSAVE←DPYPARS;
DPYSET(DBUF);
FADCHG(LIML,LIMT,AIVECT);
FRDCHG(LIMR,LIMT,RVECT);
FRDCHG(LIMR,LIMB,RVECT);
FRDCHG(LIML,LIMB,RVECT);
FRDCHG(LIML,LIMT,RVECT);
DPYOUT(DEBF);
DPYRESET(DSAVE);
END;
PROOBJ ← OBJCNT;
DEBOUT("""FINE CORNER (""&CVF(X)&"",""&CVF(Y)&"")""");
WHILE ¬OPSCAN(ARG,STATUS,TEST,LIMT,LIMB,LIML,LIMR) DO;
GO TO L1;
END;
IF DEBUGX THEN RELPOG(DEBF);
END;
⊃ TEST PARAMETERS. BODY OF EDGE STARTS HERE;
TARG ← ARG;
SETBREAK(10,'12,'15,"IN");
TRACCHK;
IF YSTRT≤TMAX∨YSTRT≥BMAX THEN
YSTRT←IF YINCR>0 THEN BMAX-YINCR ELSE TMAX+YINCR;
IF XSTRT≤LSMAX∨YSTRT≥RSMAX THEN
XSTRT←IF XINCR>0 THEN LSMAX+XINCR ELSE RSMAX-XINCR;
EINIT ← ¬YSTRT∨¬XSTRT;
IF LSMAX≥RSMAX∨TMAX≥BMAX∨¬XINCR∨¬YINCR
THEN BEGIN STATUS ← -2;RETURN(TRUE);END;
COMMENT INITIALIZE SCAN;
SETFORMAT(8,2);
STATUS ← 0;
IF XINCR>0 THEN
BEGIN
LL←LSMAX+XINCR;
RL←RSMAX-XINCR;
END ELSE BEGIN
LL←RSMAX+XINCR;
RL←LSMAX-XINCR;
END;
IF YINCR>0 THEN
BEGIN
TL←TMAX+2;
BL←BMAX-2;
END ELSE BEGIN
TL←BMAX-2;
BL←TMAX+2;
END;
IF YES_CAM∧TVCAM=1∧¬ST THEN
BEGIN
EXTERNAL SHORT INTEGER P1, P2, P3, E1, E2, E3;
EXTERNAL PROCEDURE CALPOT;
CALPOT;
IF ABS(P1-FOCPOT)>E1∨ABS(P2-TILPOT)>E2∨ABS(P3-PANPOT)>E3 THEN
ISSUE(7,"EDGE","CAM",MESSAGE CAM_UPDATE);
END;
IF ¬EDGINIT THEN INITIAL;
PROOBJ ← 0;
IF XSCAN(TRUE,TL,BL,LL,RL,XINCR,YINCR,ARG,STATUS,X,Y) THEN
BEGIN
STATUS ← -1;
TARG ← ARG ← NIL;
GO TO ENDLAB;
END;
XSAV ← XSTRT ← X;
YSAV ← YSTRT ← Y;
TEMPARG ← ARG;
FNDPNT(ARG,STATUS);
ARG ← TEMPARG;
XSTRT ← XSAV;
YSTRT ← YSAV;
ENDLAB: IF TARG≠EVERY THEN OUTOBJ(STATUS);
END "EDGE";
END "OUTSID";